Magnum One/Magnum One (Mid-American Digital) (Disc Manufacturing).iso/d18/vmmngr.arc/VMM.IN4

Text File | 1990-07-16 | 9.2 KB | 274 lines

{*********************************************************}
{*                   VMM.IN4 1.00                        *}
{*********************************************************}

  {+++ Internal methods +++}

  function VMM.PageOut(SizeNeeded : LongInt) : Boolean;
    {-Page out until "SizeNeeded" bytes become available in the Ram area}
    { Return false if not possible}
  var
    Failed     : Boolean;
    CurHandle  : VmmHandle;
    SD         : VmmDescriptor;
    D          : VmmDescriptor;
    P          : VmmPtr;
    Index      : Byte;
    Err        : Word;
  begin
   Failed := false;
     if vmLruQueue.IsEmpty then begin  {Nothing to page out - this}
     PageOut := false;                 { error should not occur unless}
     Exit;                             { ClearRamArea has been called}
   end;                                { twice in a row}

   while (not vmLruQueue.IsEmpty)
         and (RamMaxAvail < SizeNeeded)
         and not Failed do begin
     vmLruQueue.PeekHead(CurHandle);            {Get next LRU handle}
     vmDescTable.GetElem(CurHandle, D);         {Load descriptor}
     if vmDescTable.GetStatus <> 0 then begin
       PageOut := false;
       Error(epFatal+ecBadParam);
       Exit;
     end;
     SD := D;
     Failed := true;  {Assume failure}

     if EmsMaxAvail >= D.Size then begin
     {Find a free entry or allocate Ems then map Ems and move data}
       P := vmEmsFreeList.GetFreeEntry(D.Size);
       if P <> nil then
         D.Ptr := P
       else begin
       {Allocate Ems}
         D.Handle := AllocateEmsPages(4);
         if D.Handle = EmsErrorCode then begin
           PageOut := false;
           Error(epFatal+ecEmsAllocation);
           Exit;
         end;
         D.Offset := 0;
         {Add free entry to make later use of remaining space in frame}
         if vmEmsFreeList.AddFreeEntry(Ptr(D.Handle, D.Size),
                                       MaxEmsBlock-D.Size) = 0 then
           Error(epNonFatal+ecOutOfEmsEntries);
       end;
       if not SaveEmsContext(D.Handle) then begin
         PageOut := false;
         Error(epFatal+ecEmsPageMapping);
         Exit;
       end;
       {Map Ems - We deal with 64k blocks only}
       for Index := 0 to 3 do
         if not MapEmsPage(D.Handle, Index, Index) then begin
           PageOut :=false;
           Error(epFatal+ecEmsPageMapping);
           Exit;
         end;
       {Move data to Ems}
       Move(SD.RamPtr^, Ptr(vmEmsBaseSeg, D.Offset)^, D.Size);
       if not RestoreEmsContext(D.Handle) then begin
         PageOut := false;
         Error(epFatal+ecEmsPageMapping);
         Exit;
       end;
       D.Location := vmInEms;
       Failed := false;
     end

     else if DskMaxAvail >=  D.Size then begin
     {Allocate disk space and move data}
       P := vmDskFreeList.GetFreeEntry(D.Size);
       if P <> nil then
         D.DskPtr := LongInt(P)
       else begin
       {No free block - append to end of file}
         D.DskPtr := vmEofPtr;
         Inc(vmEofPtr, D.Size);
       end;
       Seek(vmF, D.DskPtr);
       BlockWrite(vmF, SD.RamPtr^, D.Size);
       Err := IoResult;
       if Err <> 0 then begin
         PageOut := false;
         Error(epFatal+Err);
         Exit;
       end;
       D.Location := vmOnDsk;
       Failed := false;
     end;

     if not Failed then begin
     {Block has been paged out}
       {Update RamFreeList and descriptor table}
       if vmRamFreeList.AddFreeEntry(SD.RamPtr, D.Size) = 0 then
         Error(epNonFatal+ecOutOfRamEntries);
       vmDescTable.SetElem(CurHandle, D);
       {Remove handle from free list only if paged out}
       vmLruQueue.PopHead(CurHandle);
     end;
   end;
   PageOut := RamMaxAvail >= SizeNeeded;
  end;

  function VMM.GetHandle : Word;
    {-Return a valid VMM handle}
  var
    CurIndex  : Word;
    CurDesc   : VmmDescriptor;
    LastIndex : Word;
  begin
    with vmDescTable do begin
      if daValidElems = 0 then
        GetHandle := 0
      else begin
        LastIndex := Pred(daValidElems);
        for CurIndex := 0 to LastIndex do begin
        {Look for a null entry in descriptor table}
          GetElem(CurIndex, CurDesc);
          if CurDesc.Location = 0 then begin
          {Assume that entry is free if Location is null}
            GetHandle := CurIndex;
            Exit;
          end;
        end;
        {not found, the next one will be the last valid one + 1}
        if LastIndex >= GetMaxIndex then begin
          GetHandle := OutOfHandles;
          Error(epFatal+ecOutOfDescEntries);
        end
        else
          GetHandle := Succ(LastIndex);
      end;
    end;
  end;

  destructor VMMDescriptorTable.Done;
    {-Deallocate all Ems handles held in descriptor table}
  var
    D         : VmmDescriptor;
    Index     : Word;
  begin
    if daValidElems > 0 then
      for Index := 0 to Pred(daValidElems) do begin
        GetElem(Index, D);
        if FlagIsSet(Word(D.Location), vmInEms)
        and not DeAllocateEmsHandle(D.Handle) then
          Error(epNonFatal+ecCantFreeEms);
      end;
    DynArray.Done;
  end;

  {---------------------------------------------------------------------}

  {+++ Internal procedures +++}
  function VmmGetMem(var P; Size : LongInt) : Boolean;
    {-Allocate heap space, returning true if successful}
    { Default function for UserGetMem}
  var
    Pt : Pointer absolute P;
  begin
    GetMem(Pt, Word(Size));     {We only use WORDs inside a VMM}
    VmmGetMem := (Pt <> nil);
  end;

  procedure VmmFreeMem(var P; Size : LongInt);
    {-Deallocate heap space}
    { Default procedure for UserFreeMem}
  var
    Pt : Pointer absolute P;
  begin
    if Pt <> nil then begin
      FreeMem(Pt, Word(Size));  {We only use WORDs inside a VMM}
      Pt := nil;
    end;
  end;

  procedure DerefHandler(AX, BX, CX, DX, SI ,DI, DS, ES, BP : Word);
  interrupt;
    {-Called when a pointer is dereferenced with VmmDrf}
  var
    P        : Pointer;
    D        : VmmDescriptor;
    H        : Word;
    Err      : Word;
    Location : Byte;
    Page     : Byte;
    Locked   : Boolean;
  begin
    with VmmActiveMgr^ do begin {VMM selected with LinkToDerefHandler}
      {AX contains VMM handle}
      H := AX;                                  {Save Handle}
      vmDescTable.GetElem(H, D);                {Get descriptor}
      if (BX = VmmMark) and (vmDescTable.GetStatus = 0) then begin
        Locked := FlagIsSet(Word(D.Location), vmLocked);
        Location := D.Location and vmLocation;
        case Location of
          vmInRam:
               begin                            {Block is in Ram area}
                 DX := VmmPtrRec(D.RamPtr).Seg;
                 AX := VmmPtrRec(D.RamPtr).Ofs;
               end;

          vmInEms, vmOnDsk:
               begin                            {Block is in Ems or on Disk}
                 {Make room for block in Ram if necessary}
                 if not(RamMaxAvail >= D.Size) then
                   if not PageOut(D.Size) then
                     ErrorExit(213); {dead lock - shouldn't occur}
                 P := vmRamFreeList.GetFreeEntry(D.Size);
                 {P cannot be nil if we get here}

                 case Location of
                   vmInEms:
                     begin  {Ems}
                       if not SaveEmsContext(D.Handle) then
                         ErrorExit(212);
                       for Page := 0 to 3 do
                         if not MapEmsPage(D.Handle, Page, Page) then
                           ErrorExit(212);
                       Move(Ptr(vmEmsBaseSeg, D.Offset)^, P^, D.Size);
                       if not RestoreEmsContext(D.Handle) then
                         ErrorExit(212);
                       if vmEmsFreeList.AddFreeEntry(D.Ptr, D.Size) = 0 then
                         Error(epNonFatal+ecOutOfEmsEntries);
                     end;
                   vmOnDsk:
                     begin  {Disk}
                       Seek(vmF, D.DskPtr);
                       BlockRead(vmF, P^, D.Size);
                       Err := IOResult;
                       if Err <> 0 then
                         ErrorExit(Err); {Can only generate run-time error}
                       if vmDskFreeList.AddFreeEntry(D.Ptr, D.Size) = 0 then
                         Error(epNonFatal+ecOutOfDskEntries);
                     end;
                 end;

                 {Update descriptor table}
                 D.Location := vmInRam;
                 D.RamPtr := P;
                 vmDescTable.SetElem(H, D);
                 {Return pointer to block in ram area}
                 DX := VmmPtrRec(P).Seg;
                 AX := VmmPtrRec(P).Ofs;
               end;
          else {Handle not recognized}
             ErrorExit(204); {Invalid pointer operation}
        end;
        {Add handle to LRU queue}
        if not Locked then with vmLruQueue do begin
          Remove(H);   {Make H a unique handle in the LRU queue}
          PushTail(H);
        end;
      end
      else begin
        {Must be a normal TP pointer - return it unchanged}
        DX := AX;
        AX := BX;
      end;
    end;
  end;